*+--------------------------------------------------------------------
*+
*+
*+
*+    Source Module => /home/paul/click/julian.prg
*+
*+
*+
*+    Click! is a Clipper/Xbase++ source code reformatter.
*+
*+    
*+
*+    Note:Phil is no longer actively developing Click!.
*+
*+    Copyright(C) 1996-1999 by Phil Barnett.
*+
*+       
*+
*+    This program is free software; you can redistribute it and/or modify it
*+
*+    under the terms of the GNU General Public License as published by the
*+
*+    Free Software Foundation; either version 2 of the License, or (at your
*+
*+    option) any later version.
*+
*+    
*+
*+    This program is distributed in the hope that it will be useful, but
*+
*+    WITHOUT ANY WARRANTY; without even the implied warranty of
*+
*+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
*+
*+    General Public License for more details.
*+
*+    
*+
*+    You should have received a copy of the GNU General Public License along
*+
*+    with this program; if not, contact the Free Software Foundation, Inc.,
*+
*+    51 Franklin St, Fifth Floor Boston, MA 02110, USA, or www.fsf.org.
*+
*+    
*+
*+    You can contact me at:
*+
*+    
*+
*+    Phil Barnett
*+
*+    Box 944
*+
*+    Plymouth, Florida  32768
*+
*+    
*+
*+    or
*+
*+    
*+
*+    philb@iag.net
*+
*+    
*+
*+    
*+
*+    Ported to Linux and xHarbour compiler, minor feature additions.
*+
*+    Changed version to 3.00xHarbour  Changes
*+
*+    GPL version 3 Copyright (C) 2006-9 by Paul States 
*+
*+    Contact:broadcastmail AT NOSPAM 123mail.org.
*+
*+
*+
*+    Functions: Function TD2JUL()
*+               Function JUL2TIME()
*+               Function JUL2DATE()
*+               Function DIFF2JUL()
*+               Function JUL_DIFF()
*+               Function JUL_BTW()
*+               Function JUL_BTWX()
*+               Function JUL_SEEK()
*+               Function JUL_AVE()
*+               Function TTOS()
*+               Function TTOMS()
*+               Function TTOM()
*+               Function MINS2HUND()
*+               Function PRB_INT()
*+               Function JUL_PACK()
*+               Function JUL_UNPACK()
*+
*+    Reformatted by Click! 3.00Harbour on Apr-13-2009 at  2:30 pm
*+
*+
*+--------------------------------------------------------------------
*+



#include "common.ch"

#define BASE_DATE "1980"



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function TD2JUL()
*+
*+    Called from ( click.prg    )   4 - procedure click()
*+
*+       Calls    ( julian.prg   )   1 - function prb_int()
*+                ( julian.prg   )   1 - function ttos()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function TD2JUL(cTime,dDate)



default cTime to time()
default dDate to date()

return dDate - ctod('01/01/'+BASE_DATE)+;
 (PRB_INT(TTOS(cTime) / 100000,,5))



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function JUL2TIME()
*+
*+       Calls    ( julian.prg   )   2 - function prb_int()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function JUL2TIME(Jul1)



local nTotSecs := val(right(str(Jul1,14,5),5))
local H
local M
local S

H        := PRB_INT(nTotSecs / 3600)
nTotSecs := nTotSecs % 3600
M        := PRB_INT(nTotSecs / 60)
S        := nTotSecs % 60

return strzero(H,2)+':'+;
 strzero(M,2)+':'+;
 strzero(S,2)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function JUL2DATE()
*+
*+       Calls    ( julian.prg   )   1 - function prb_int()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function JUL2DATE(Jul1)



return ctod('01/01/'+BASE_DATE)+PRB_INT(Jul1)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function DIFF2JUL()
*+
*+    Called from ( click.prg    )   1 - procedure click()
*+                ( julian.prg   )   2 - function jul_seek()
*+                                   1 - function jul_ave()
*+
*+       Calls    ( julian.prg   )   8 - function prb_int()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function DIFF2JUL(Jul1,Jul2)



local M
local S
local H
local retval

local J1 := min(Jul1,Jul2)
local J2 := max(Jul1,Jul2)
local D  := PRB_INT(J2) - PRB_INT(J1)

local nTotSecs := val(right(str(J2,14,5),5)) - ;
 val(right(str(J1,14,5),5))

D        -= PRB_INT(abs(nTotSecs) / 86400)+1
nTotSecs := PRB_INT(nTotSecs % 86400)+86400

H        := PRB_INT(nTotSecs / 3600)+(D * 24)
nTotSecs := PRB_INT(nTotSecs % 3600)
M        := PRB_INT(nTotSecs / 60)
S        := PRB_INT(nTotSecs % 60)

if S > 59
   M ++
   S := 0
   if M > 59
      H ++
      M := 0
   endif
endif

do case
case h > 0
   retval := strzero(H,7)+':'+;
    strzero(M,2)+':'+;
    strzero(S,2)
case m > 0
   retval := strzero(M,2)+':'+;
    strzero(S,2)
otherwise
   retval := ltrim(str(S,2))+' Seconds'
endcase

return retval



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function JUL_DIFF()
*+
*+    Called from ( julian.prg   )   1 - function jul_ave()
*+
*+       Calls    ( julian.prg   )   7 - function prb_int()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function JUL_DIFF(Jul1,OFFSET)



local D := PRB_INT(Jul1)
local S := val(right(str(Jul1,14,5),5))+(PRB_INT(OFFSET * 60))

if S < 0
   D -= PRB_INT(abs(S) / 86400)+1
   S := PRB_INT(abs(S) % 86400)
elseif S > 86399
   D += PRB_INT(S / 86400)
   S := PRB_INT(S % 86400)
endif

return PRB_INT(D+(S / 100000),,5)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function JUL_BTW()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function JUL_BTW(Jul1,Jul2,Unk)



return (Jul1 <= Unk) .and. (Unk <= Jul2)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function JUL_BTWX()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function JUL_BTWX(Jul1,Jul2,Unk)



return (Jul1 < Unk) .and. (Unk < Jul2)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function JUL_SEEK()
*+
*+       Calls    ( julian.prg   )   2 - function diff2jul()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function JUL_SEEK(Jul1,Jul2,Unk)



return iif(DIFF2JUL(Jul1,Unk) < DIFF2JUL(Jul2,Unk),1,2)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function JUL_AVE()
*+
*+       Calls    ( julian.prg   )   1 - function diff2jul()
*+                ( julian.prg   )   1 - function jul_diff()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function JUL_AVE(Jul1,Jul2)



local DIFF := DIFF2JUL(min(Jul1,Jul2),max(Jul1,Jul2))
local H    := val(left(DIFF,7))
local M    := val(substr(DIFF,9,2))
local S    := val(substr(DIFF,12,2))

return JUL_DIFF(min(Jul1,Jul2),((S / 60)+M+(H * 60)) / 2)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function TTOS()
*+
*+    Called from ( julian.prg   )   1 - function td2jul()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function TTOS(cTime)



return (val(substr(cTime,7,2)))+;
 (val(substr(cTime,4,2)) * 60)+;
 (val(substr(cTime,1,2)) * 3600)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function TTOMS()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function TTOMS(cTime)



return (val(substr(cTime,7,2)) / 60)+;
 (val(substr(cTime,4,2)))+;
 (val(substr(cTime,1,2)) * 60)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function TTOM()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function TTOM(cTime)



return (val(substr(cTime,4,2)))+;
 (val(substr(cTime,1,2)) * 60)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function MINS2HUND()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function MINS2HUND(nMinutes)



return nMinutes / 60



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function PRB_INT()
*+
*+    Called from ( julian.prg   )   1 - function td2jul()
*+                                   2 - function jul2time()
*+                                   1 - function jul2date()
*+                                   8 - function diff2jul()
*+                                   7 - function jul_diff()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function PRB_INT(nSomeNumber,nLength,nDecimals)



local lNegative   := (nSomeNumber < 0)
local cSomeString
local nDotAt

default nDecimals to 0
default nLength to 19

if lNegative
   nSomeNumber := abs(nSomeNumber)
endif

nSomeNumber += .0000000000000005

cSomeString := alltrim(str(nSomeNumber))

nDotAt := at('.',cSomeString)

if nDecimals > 0
   if nDotAt > 0
      cSomeString := left(cSomeString,nDotAt+nDecimals)
   endif
else
   if nDotAt > 0
      cSomeString := left(cSomeString,nDotAt - 1)
   endif
endif

if lNegative
   cSomeString := '-'+cSomeString
endif

return val(cSomeString)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function JUL_PACK()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function JUL_PACK(nJulian)



local cJulian  := strtran(strzero(nJulian,11,5),'.')
local cPackJul := ''
local x

for x := 1 to 10 step 2
   cPackJul += chr(val(substr(cJulian,x,2)))
next

return cPackJul



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function JUL_UNPACK()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function JUL_UNPACK(cPackJul)



local cJulian := ''
local x

for x := 1 to 5
   cJulian += strzero(asc(substr(cPackJul,x,1)),2)
next

return val(left(cJulian,5)+'.'+substr(cJulian,6,5))



*+ EOF: julian.prg
*+
